Developer CD Series 2000 August: Tool Chest/Dev.CD Aug 00 TC Disk 2.toast/pc/sample code/human interface toolbox/bigscrolling/sample.p

Text File | 2000-06-23 | 21.0 KB | 620 lines

{
    File:        Sample.p

    Contains:    ScrollBars are limited in their range to a signed 16-bit number (+/- 32768).
                This project demo's one way to work around this limitation.

    Written by:

    Copyright:    Copyright © 1999 by Apple Computer, Inc., All Rights Reserved.

                You may incorporate this Apple sample source code into your program(s) without
                restriction. This Apple sample source code has been provided "AS IS" and the
                responsibility for its operation is yours. You are not permitted to redistribute
                this Apple sample source code as "Apple sample source code" after having made
                changes. If you're going to re-distribute the source, we require that you make
                it clear in the source that the code was descended from Apple sample source
                code, but that you've made changes.

    Change History (most recent first):
                7/16/1999    Karl Groethe    Updated for Metrowerks Codewarror Pro 2.1


}
program Sample;

uses
    Traps,Windows,Quickdraw,Devices,Dialogs,BigScrolling,DiskInit;
const {}

    kNoEvents = 0; {no events mask}
    kMinHeap = 21 * 1024;      {1.01 - kMinSpace - This is the minimum result from PurgeSpace, when called}
       {     at initialization time, for the application to run. This number acts}
     {      as a double-check to insure that there really is enough memory for the}
         {      application to run, including what has been taken up already by}
     {      pre-loaded resources, the scrap, code, and other sundry memory blocks.}
    kMinSpace = 8 * 1024;  {kExtremeNeg and kExtremePos are used to set up wide open rectangles and regions.}
    kExtremeNeg = -32768;
    kExtremePos = 32767 - 1; {required for old region bug}

 {The following constants are all resource IDs, corresponding to resources in Sample.r.}
    rMenuBar = 128; {application's menu bar}
    rAboutAlert = 128; {about alert}
    rUserAlert = 129; {error user alert}

 {The following constants are used to identify menus and their items. The menu IDs}
 {      have an "m" prefix and the item numbers within each menu have an "i" prefix.}
    mApple = 128; {Apple menu}
    iAbout = 1;
    mFile = 129; {File menu}
    iQuit = 1;
    mEdit = 130; {Edit menu}
    iUndo = 1;
    iCut = 3;
    iCopy = 4;
    iPaste = 5;
    iClear = 6;  {1.01 - kDITop and kDILeft are used to locate the Disk Initialization dialogs.}
    kDITop = $0050;
    kDILeft = $0070;
var
       {GInBackground is maintained by our osEvent handling routines. Any part of}
 {      the program can check it to find out if it is currently in the background.}
    gInBackground: BOOLEAN; {maintained by Initialize and DoEvent}
    cursorRgn: RgnHandle;  { cursorRgn contains a copy of the last mouseRgn we passed to WaitNextEvent}

{$S Main}

function IsDAWindow (window: WindowPtr): BOOLEAN;

    {Check if a window belongs to a desk accessory.}

    begin
        if window = nil then
            IsDAWindow := FALSE
        else {DA windows have negative windowKinds}
            IsDAWindow := (WindowPeek(window)^.windowKind < 0);
    end; {IsDAWindow}

    {$S Main}

function IsAppWindow (window: WindowPtr): BOOLEAN;

    {Check to see if a window belongs to the application. If the window pointer}
    { passed was NIL, then it could not be an application window. WindowKinds}
    { that are negative belong to the system and windowKinds less than userKind}
    { are reserved by Apple except for windowKinds equal to dialogKind, which}
    { mean it is a dialog.}
    { 1.02 - In order to reduce the chance of accidentally treating some window}
 { as an AppWindow that shouldn't be, we'll only return true if the windowkind}
    { is userKind. If you add different kinds of windows to Sample you'll need}
    { to change how this all works.}

    begin
        if window = nil then
            IsAppWindow := FALSE
        else {application windows have windowKinds = userKind (8)}
            with WindowPeek(window)^ do
                IsAppWindow := (windowKind = userKind);
    end; {IsAppWindow}

    {$S Main}

{$Z+}
 {for trafficlights.p}

procedure AlertUser;

{Display an alert that tells the user an error occurred, then exit the program.}
{ This routine is used as an ultimate bail-out for serious errors that prohibit}
{ the continuation of the application. Errors that do not require the termination}
{ of the application should be handled in a different manner. Error checking and}
{ reporting has a place even in the simplest application. For simplicity, the alert}
{ displayed here only says that an error occurred, but not what it was. There are}
    { various methods available for being more specific.}

    var
        itemHit: integer;

    begin
        SetCursor(qd.arrow);
        itemHit := Alert(rUserAlert, nil);
        ExitToShell;
    end; {AlertUser}

    {$S Main}

function DoCloseWindow (window: WindowPtr): BOOLEAN;

    {Close a window.}

    {1.01 - At this point, if there was a document associated with a}
    { window, you could do any document saving processing if it is 'dirty'.}
    { DoCloseWindow would return TRUE if the window actually closes, i.e.,}
    { the user does not cancel from a save dialog. This result is handy when}
    { the user quits an application, but then cancels a save of a document}
    { associated with a window. We also added code to close the application}
  { window since otherwise, the termination routines would never stop looping,}
    { waiting for FrontWindow to return NIL.}

    begin
        DoCloseWindow := TRUE;
        if IsDAWindow(window) then
            begin
                CloseDeskAcc(WindowPeek(window)^.windowKind);
            end
        else if IsAppWindow(window) then
            begin
                CloseAppWindow(window);
            end
    end; {DoCloseWindow}

    {$S Initialize}

procedure Initialize;

    {Set up the whole world, including global variables, Toolbox managers,}
    { and menus. We also create our one application window at this time.}

    { If a failure occurs here, we will consider that the application is in such}
    { bad shape that we should just exit. Your error handling may differ, but}
    { the checks should still be made.}


    var
        menuBar: Handle;
        total, contig: LongInt;

    begin
        gInBackground := FALSE;

        InitGraf(@qd.thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
        InitCursor;

{1.01 - We used to make a check for memory at this point by examining ApplLimit,}
{      ApplicZone, and StackSpace and comparing that to the minimum size we told}
{      MultiFinder we needed. This did not work well because it assumed too much about}
{      the relationship between what we asked MultiFinder for and what we would actually}
{      get back, as well as how to measure it. Instead, we will use an alternate}
            {      method comprised of two steps.}

 {It is better to first check the size of the application heap against a value}
{      that you have determined is the smallest heap the application can reasonably}
{      work in. This number should be derived by examining the size of the heap that}
{      is actually provided by MultiFinder when the minimum size requested is used.}
{      The derivation of the minimum size requested from MultiFinder is described}
{      in Sample.h. The check should be made because the preferred size can end up}
{      being set smaller than the minimum size by the user. This extra check acts to}
 {     insure that your application is starting from a solid memory foundation.}

        if ORD(GetApplLimit) - ORD(ApplicationZone) < kMinHeap then
            AlertUser;

    {Next, make sure that enough memory is free for your application to run. It}
{      is possible for a situation to arise where the heap may have been of required}
{      size, but a large scrap was loaded which left too little memory. To check for}
{      this, call PurgeSpace and compare the result with a value that you have determined}
{      is the minimum amount of free memory your application needs at initialization.}
{      This number can be derived several different ways. One way that is fairly}
{      straightforward is to run the application in the minimum size configuration}
{      as described previously. Call PurgeSpace at initialization and examine the value}
{      returned. However, you should make sure that this result is not being modified}
{      by the scrap's presence. You can do that by calling ZeroScrap before calling}
         {     PurgeSpace. Make sure to remove that call before shipping, though.}

        PurgeSpace(total, contig);
        if total < kMinSpace then
            AlertUser;

{The extra benefit to waitng until after the Toolbox Managers have been initialized}
{      before checking memory is that we can now give the user an alert to tell him what}
{      happened. Although it is possible that the memory situation could be worsened by}
{      displaying an alert, MultiFinder would gracefully exit the application with}
  {     an informative alert if memory became critical. Here we are acting more}
{      in a preventative manner to avoid future disaster from low-memory problems.}

        menuBar := GetNewMBar(rMenuBar); {read menus into menu bar}
        if menuBar = nil then
            AlertUser;
        SetMenuBar(menuBar); {install menus}
        DisposeHandle(menuBar);
        AppendResMenu(GetMenuHandle(mApple), 'DRVR'); {add DA names to Apple menu}
        DrawMenuBar;

{     InitializeApplication is a call to another unit (BigScrolling.p in this case).  This is}
{     here so you can put any application-specific code where it belongs instead of in the main }
{     program all the time.    }

        InitializeApplication; { give some other unit the chance to initialize}
{                                            itself }

    end; {Initialize}

    {$S Main}

procedure Terminate;

    {Clean up the application and exits. We close all of the windows so that}
    { they can update their documents, if any.}

    {1.01 - If we find out that a cancel has occurred, we won't exit to the}
    { shell, but will return instead.}

    var
        aWindow: WindowPtr;
        closed: BOOLEAN;

    begin
        closed := TRUE;
        repeat
            aWindow := FrontWindow; {get the current front window}
            if aWindow <> nil then
                closed := DoCloseWindow(aWindow); {close}
{                    this window}
        until (not closed) | (aWindow = nil); {do all windows}

{     TerminateApplication is a call to another unit (TrafficLights.p in the case of Sample).    This is}
{     here so you can put any application-specific code where it belongs instead of in the main }
            {     program all the time.    }

        TerminateApplication; { give some other unit the chance to kill itself}
{                                          }

        if closed then
            ExitToShell; {exit if no cancellation}
    end; {Terminate}

    {$S Main}

procedure AdjustMenus;

    {Enable and disable menus based on the current state.}
    { The user can only select enabled menu items. We set up all the menu items}
    { before calling MenuSelect or MenuKey, since these are the only times that}
    { a menu item can be selected. Note that MenuSelect is also the only time}
    { the user will see menu items. This approach to deciding what enable/}
{ disable state a menu item has the advantage of concentrating all the decision-}
{ making in one routine, as opposed to being spread throughout the application.}
{ Other application designs may take a different approach that may or may not be}
    { just as valid.}

{ 9/12/91, (MD) -- Added enabling and disabling page setup and print around DA windows. }

    var
        window: WindowPtr;
        menu: MenuHandle;

    begin
        window := FrontWindow;

        menu := GetMenuHandle(mEdit);
        if IsDAWindow(window) then
            begin {a desk accessory might need the edit}
{                                                         menu}
                EnableItem(menu, iUndo);
                EnableItem(menu, iCut);
                EnableItem(menu, iCopy);
                EnableItem(menu, iPaste);
                EnableItem(menu, iClear);
            end
        else
            begin {but we know we do not}
                DisableItem(menu, iUndo);
                DisableItem(menu, iCut);
                DisableItem(menu, iCopy);
                DisableItem(menu, iClear);
                DisableItem(menu, iPaste);
            end;

    end; {AdjustMenus}

    {$S Main}

procedure DoMenuCommand (menuResult: LongInt);

    {This is called when an item is chosen from the menu bar (after calling}
    { MenuSelect or MenuKey). It performs the right operation for each command.}
    { It is good to have both the result of MenuSelect and MenuKey go to}
    { one routine like this to keep everything organized.}

    var
        menuID: integer; {the ID of the selected menu}
        menuItem: integer; {the item number of the selected menu}
        itemHit: integer;
        daName : Str255;
        daRefNum: integer;
        handledByDA: BOOLEAN;

    begin
        menuID := HiWrd(menuResult); {use built-ins (for efficiency)...}
        menuItem := LoWrd(menuResult); {to get menu item number and menu}
{                                                      number}
        case menuID of
            mApple:
                case menuItem of
                    iAbout: {bring up alert for About}
                        itemHit := Alert(rAboutAlert, nil);
                    otherwise
                        begin {all non-About items in this menu are DAs}
                            GetMenuItemText(GetMenuHandle(mApple), menuItem, daName);
                            daRefNum := OpenDeskAcc(daName);
                        end;
                end;
            mFile:
                case menuItem of
                    iQuit:
                        Terminate;
                end;
            mEdit: {call SystemEdit for DA editing & MultiFinder}
                handledByDA := SystemEdit(menuItem - 1); {since we don't do any}
{                                                                            editing}
            otherwise
                ;        { The System takes care of Apple, Help and Application menus for us when we call}
{                                       MenuSelect, but it's good form to have all cases covered with a statement. }
        end;
        HiliteMenu(0); {unhighlight what MenuSelect (or MenuKey) hilited}
    end; {DoMenuCommand}

    {$S Main}

procedure DoUpdate (window: WindowPtr);

    {This is called when an update event is received for a window.}
    { It calls DrawWindow to draw the contents of an application window.}
    { As an effeciency measure that does not have to be followed, it}
    { calls the drawing routine only if the visRgn is non-empty. This}
    { will handle situations where calculations for drawing or drawing}
    { itself is very time-consuming.}

    begin
        if IsAppWindow(window) then
            begin
                BeginUpdate(window); {sets up the visRgn, clears updateRgn}
                if not EmptyRgn(window^.visRgn) then {draw if updating needs to be}
{                                                                  done}
                    DrawWindow(window, nil, FALSE, window = FrontWindow); {when we update,}
{                    we're not printing}
                EndUpdate(window); {restores the visRgn}
            end;
    end; {DoUpdate}

    {$S Main}

procedure DoActivate (window: WindowPtr; becomingActive: BOOLEAN);

    {This is called when a window is activated or deactivated.}
    { In Sample, the Window Manager's handling of activate and}
    { deactivate events is sufficient. Other applications may have}
    { TextEdit records, controls, lists, etc., to activate/deactivate.}

    begin
        if IsAppWindow(window) then
            DrawWindow(window, nil, FALSE, becomingActive);
    end; {DoActivate}

    {$S Main}

procedure GetGlobalMouse (var mouse: point);

    {Get the global coordinates of the mouse. When you call OSEventAvail}
    { it will return either a pending event or a null event. In either case,}
    { the where field of the event record will contain the current position}
    { of the mouse in global coordinates and the modifiers field will reflect}
    { the current state of the modifiers. Another way to get the global}
    { coordinates is to call GetMouse and LocalToGlobal, but that requires}
    { being sure that thePort is set to a valid port.}

    var
        event: EventRecord;

    begin
        if OSEventAvail(kNoEvents, event) then
            ; {we aren't interested in any}
{                                                                 events}
        mouse := event.where; {just the mouse position}
    end;

    {$S Main}

procedure AdjustCursor (mouse: point);

{Change the cursor's shape, depending on its position. This also calculates the region}
{ where the current cursor resides (for WaitNextEvent). If the mouse is ever outside of}
 { that region, an event is generated, causing this routine to be called. This}
  { allows us to change the region to the region the mouse is currently in. If}
{ there is more to the event than just “the mouse moved”, we get called before the}
{ event is processed to make sure the cursor is the right one. In any (ahem) event,}
    { this is called again before we fall back into WNE.}

    var
        window: WindowPtr;
        arrowRgn: RgnHandle;
        plusRgn: RgnHandle;

    begin
        window := FrontWindow; {we only adjust the cursor when we are in}
{                                            front}
        if (not gInBackground) and (not IsDAWindow(window)) then
            begin
                {calculate regions for different cursor shapes}
                arrowRgn := NewRgn;
                plusRgn := NewRgn;

                {start with a big, big rectangular region}
                {1.01 - changed to kExtremeNeg and kExtremePos for consistency}
                SetRectRgn(arrowRgn, kExtremeNeg, kExtremeNeg, kExtremePos, kExtremePos);

                {calculate plusRgn}
{ In previous versions of Sample, this routine was significantly more complicated than}
{ it is now.  It used to create a rectangular region based on a window's portRect, intersect }
{it with the visRgn.  Since the visRgn is in local coordinates and the contentRgn is in global}
{coordinates, this used to be a fair amount of calculation.  All of which was unnecessary, }
{because:  a)  We only do this for our frontmost window, which is always completely visible}
{unless we have some kind of floating window in front of it, and b) we can't move the mouse}
{into any part of the content region that's not on-screen.}
{This routine now uses the contentRgn of the frontWindow for the plusRgn, exclusively.}

                if IsAppWindow(window) then
                    CopyRgn(WindowPeek(window)^.contRgn, plusRgn);

                {subtract other regions from arrowRgn}
                DiffRgn(arrowRgn, plusRgn, arrowRgn);

                {change the cursor and the region parameter}
                if PtInRgn(mouse, plusRgn) then
                    begin
                        SetCursor(GetCursor(plusCursor)^^);
                        CopyRgn(plusRgn, cursorRgn);
                    end
                else
                    begin
                        SetCursor(qd.arrow);
                        CopyRgn(arrowRgn, cursorRgn);
                    end;

                {get rid of our local regions}
                DisposeRgn(arrowRgn);
                DisposeRgn(plusRgn);
            end;
    end; {AdjustCursor}

    {$S Main}

procedure DoEvent (event: EventRecord);

{Do the right thing for an event. Determine what kind of event it is, and call}
    { the appropriate routines.}

    var
        part, err: integer;
        window: WindowPtr;
        key: CHAR;
        aPoint: point;

    begin
        case event.what of
            mouseDown:
                begin
                    part := FindWindow(event.where, window);
                    case part of
                        inDesk:
                            ;
                        inMenuBar:
                            begin {process the menu command}
                                AdjustMenus;
                                DoMenuCommand(MenuSelect(event.where));
                            end;
                        inSysWindow: {let the system handle the mouseDown}
                            SystemClick(event, window);
                        inContent:
                            if window <> FrontWindow then
                                begin
                                    SelectWindow(window);
                                {DoEvent(event);}
                                {use this line for "do first click"}
                                end
                            else
                                DoContentClick(window, event);
                        inDrag:
                            begin
                                {pass screenBits.bounds to get all gDevices}
                                DragWindow(window, event.where, qd.screenBits.bounds);
                                AdjustCursor(event.where);
                            end;
                        inGrow:
                            ;
                        inZoomIn, inZoomOut:
                            ;
                    end;
                end;
            keyDown, autoKey:
                begin {check for menukey equivalents}
                    key := CHR(BAND(event.message, charCodeMask));
                    if BAND(event.modifiers, cmdKey) <> 0 then {Command key down}
                        if event.what = keyDown then
                            begin
                                AdjustMenus; {enable/disable/check menu items properly}
                                DoMenuCommand(MenuKey(key));
                            end;
                end; {call DoActivate with the window and...}
            activateEvt: {TRUE for activate, FALSE for deactivate}
                DoActivate(WindowPtr(event.message), BAND(event.modifiers, activeFlag) <> 0);
            updateEvt: {call DoUpdate with the window to update}
                DoUpdate(WindowPtr(event.message));
             {1.01 - It is not a bad idea to at least call DIBadMount in response}
                {            to a diskEvt, so that the user can format a floppy.}
            diskEvt:
                if HiWrd(event.message) <> noErr then
                    begin
                        SetPt(aPoint, kDILeft, kDITop);
                        err := DIBadMount(aPoint, event.message);
                    end;
            osEvt:
                case BAND(BRotL(event.message, 8), $FF) of {high byte of message}
                    SuspendResumeMessage:
                        begin
                            gInBackground := BAND(event.message, resumeFlag) = 0;
                            DoActivate(FrontWindow, not gInBackground);
                        end;
                    mouseMovedMessage:
                        AdjustCursor(event.where);
                end;
            otherwise
                ;
        end;
    end; {DoEvent}

    {$S Main}

procedure EventLoop;

    {Get events forever, and handle them by calling DoEvent.}
    { Get the events by calling WaitNextEvent, if it's available, otherwise}
 { by calling GetNextEvent. Also call AdjustCursor each time through the loop.}

    var
        gotEvent: BOOLEAN;
        event: EventRecord;
        mouse: point;

    begin
        cursorRgn := NewRgn;
        GetGlobalMouse(mouse);   { find the current mouse position }
        AdjustCursor(mouse);  { set up the cursor once }
        repeat
{put us 'asleep' forever under}
{                                                            MultiFinder}
            gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn);

            if gotEvent then
                DoEvent(event);
                {If you are using modeless dialogs that have editText items,}
         {          you will want to call IsDialogEvent to give the caret a chance}
 {          to blink, even if WNE/GNE returned FALSE. However, check FrontWindow}
                {            for a non-NIL value before calling IsDialogEvent.}
        until FALSE; {loop forever; we quit through an ExitToShell}
    end; {EventLoop}

    {This routine is part of the MPW runtime library. This external}
    { reference to it is done so that we can unload its segment, %A5Init.}

    {$S Main}

begin

        {1.01 - call to ForceEnvirons removed}
        {If you have stack requirements that differ from the default,}
        {      then you could use SetApplLimit to increase StackSpace at }
        {      this point, before calling MaxApplZone.}

    MaxApplZone; {expand the heap so code segments load at the top}

    Initialize; {initialize the program}
    //UnloadSeg(@Initialize); {note that Initialize must not be in Main!}

    EventLoop; {call the main event loop}
end.